open Utils.Pervasive
open Utils.Error
open Utils.Statistics
open Utils.StringSpecial

open Syntax
open Binding
open PrintExpr
open GPUtils
open Pointers

open BlockPopulation
open BlockPopulation.Gene

open Rules
open Expr_visual
open List 

open Gobject.Data
open Core
open StdLabels
open GtkTree

let rec make_expr_panel ?(ruleDebug=true)  env expr genes =
	let ctx = gpContext genes in
	let panel title = 
		let pan = GBin.frame ~label:(title^ "...") ~packing:env#add ( ) in
		GPack.vbox ~width:580 ~packing:pan#add ( ) in
	let button str packer ( ) = GButton.button ~label:str ~packing:packer#add () in
	let evalPanel = panel "Expression" in
	let box_eval = GPack.hbox ~packing:evalPanel#add () in
	let box_eval_left = GPack.vbox ~packing:box_eval#add () in
	let expr_label = GText.view 
			~width:300 
			~height:300 
			~border_width:3 
			~wrap_mode:`WORD
			~packing:box_eval_left#add( ) 	in 
	
	expr_label#buffer#set_text (string_of_expr ctx expr Compact); 

	if ruleDebug then(
		let rulePanel = panel "Rules" in
		for ctr = 0 to (Array.length rules) - 1 do 
			let btn = GButton.check_button  
				~label:(string_of_int ctr) 
				~active:(rules.(ctr).app)
				~packing:rulePanel#add ( ) in
			let callb i ( ) = rules.(i).app <- not((rules.(i)).app) in
			un(btn#connect#toggled  ~callback:(callb ctr)); 
			( )
		done;
	
	let doRule( ) = ()(* 
		let  exprList = new_subset	ctx genes expr (get_applicable_rules ctx genes expr) in 
		expr_label#buffer#set_text 
		(String.concat "\n" (List.map (fun expr -> string_of_expr ctx expr Compact) exprList)); 
		List.iter (fun g -> ins genes g) exprList *)
		in
		 		
	let doRule_btn = button "Do" rulePanel( )	 in 
	un(doRule_btn#connect#clicked  ~callback:doRule))		
let view_gene expr poolRef ?(dispEvaluate=false) ( ) = 			
	let ctx = gpContext !poolRef in
	if dispEvaluate then (show_expr_window ctx expr ( ))
	else( 	
	let window = GWindow.window ~title:"Gene..." ( ) in
		window#set_default_size ~width:500 ~height:200;
   
	let box1 = GPack.hbox ~width:500 ~packing:window#add () in
	let boxMenu = GPack.vbox ~width:500 ~packing:box1#add () in
	let panel ?(box = boxMenu) title = 
		let pan = GBin.frame ~label:(title^ "...") ~packing:box#pack ( ) in
		GPack.vbox ~width:490 ~packing:pan#add ( ) in
	
	let empty_entry ?(editable=false) ?(text="") packer ( ) = 
    GEdit.entry ~editable ~text  ~width:490  ~packing:packer#add ( ) in
	let button str packer ( ) = GButton.button ~label:str ~packing:packer#add () in

    let exprPanel = panel "expr" in
    make_expr_panel exprPanel expr !poolRef;
    window#show( ))


let cols = new GTree.column_list 
let refer_col = cols#add string
let sel_prob = cols#add string 
let seedCtr_col = cols#add string
let use_col = cols#add string
let comp_col = cols#add string
let gene_col = cols#add string 
let fit_col = cols#add string
let bg = cols#add (unsafe_boxed (Gobject.Type.from_name "GdkColor"))

let add_columns ~(view : GTree.view) ~model = 
	let renderer = GTree.cell_renderer_text [`XALIGN 0.] in 
	
	iter (fun (title,col) ->
			let vc = GTree.view_column ~title 
			~renderer:(renderer, ["text", col]) ( ) in
			vc#add_attribute renderer "background-gdk" bg;
			un(view#append_column vc))
	[("Use" , use_col) ;
	 ("SelProb", sel_prob);
	("Seed", seedCtr_col); 
	("Fit", fit_col);
	("", refer_col) ; 
	("Comp", comp_col);
	("ID" , gene_col)]
	
let clean ~(model : GTree.tree_store)	= 
		try	 let iter = model#iter_children ~nth:0 None in
			let remove = ref (model#remove iter) in
			while !remove do
				remove := model#remove iter 
			done
		with _->( ) 		
let flat_list  ?(exprList=[ ]) ?(geneLst=[ ]) ?(viewType = Compact) ~(model : GTree.tree_store) ctx= 
	clean ~model;
	if List.length exprList > 0 then 
		ListLabels.iter exprList
		~f:(fun expr -> 
			let row = model#append ( ) in 
			let set column = model#set ~row ~column in 
			List.iter (fun (str,column) -> set column str)
				[(string_of_expr ctx expr viewType, refer_col)];
				set bg (GDraw.color (`NAME "orange"))) 
	
	else ListLabels.iter geneLst
	~f:(fun alle -> 
		let row = model#append ( ) in 
		let set column = model#set ~row ~column in 
		List.iter (fun (str,column) -> set column str)
				[(string_of_term ctx (alleExpr alle) viewType, refer_col);
				(string_of_float (alleSelectionProb alle), sel_prob);
				(string_of_int (alleUseInPopulation alle), use_col);
				(string_of_float (alleSelectionProb alle), fit_col);
				(string_of_int (alleSeedSelectionCount alle), seedCtr_col);
				(string_of_int (alleComplexity alle), comp_col)];
				set bg (GDraw.color (`NAME "orange")))
				
				 							
let update genes ?(viewType = Compact) ~(model : GTree.tree_store) = 
	clean ~model;
	let ctx = gpContext genes in 
	
	gpIter(fun ty cinfo lst ->
		let row = model#append ( ) in 
		let set column = model#set ~row ~column in 
		List.iter (fun (column, str) -> set column str)
		[(fit_col, string_of_float cinfo.totalFitness);  
		(refer_col, string_of_type ctx ty viewType);
		(use_col, string_of_int cinfo.species_use)];

		List.iter lst
		~f: (fun alle -> 
				let row = model#append ~parent:row () in 
				let set column = model#set ~row ~column in 
				List.iter (fun (str,column) -> set column str)
				[(string_of_term ctx (alleExpr alle) viewType, refer_col); 
				(string_of_float (alleFitness alle), fit_col);
				(string_of_int (alleId alle), gene_col);
				(string_of_int (alleUseInPopulation alle), use_col);
				(string_of_int (alleComplexity alle), comp_col)];
				set bg (GDraw.color (`NAME "orange")))) genes
				
let create_models genes  = 
	let model = GTree.tree_store cols in 
	update genes ~model;
	model	
let on_row_activated ?(dispEvaluate=false) genes_ref (view:GTree.view) path column =
	let model = view#model in
	let row = model#get_iter path in
	let expr_string = model#get ~row ~column:refer_col in
	let ctx = gpContext !genes_ref in
	let expr = parse_string expr_string ctx in
	view_gene ~dispEvaluate expr genes_ref ( )
	
let buildToComplexity growUnit genes ~(model : GTree.tree_store) constraintFunc ( ) =  
	growToComplexity ~debug:false ~growUnit
	genes constraintFunc
	~onSuccess:(fun bpset _ -> prf "\nsuccess")
	~onFailure:(fun str -> prf "\nfailure");
	update ~model genes
	
type gene_window_setting = 
	| DisplayEvaluate | ShowOnlySubset of t_Expr list 
	| BuildInit of int | ShowGrowByOne 
	| ShowGrowByComp of int | Hide 
	| MaxSize of int | ConstraintFunction of constraint_function
	| Report of out_channel 	
	
		
let gene_window pool_ref settings =	
	let ctx = gpContext !pool_ref in	
	let window = GWindow.window ~title:"gene pool" () in
		window#set_default_size ~width:1000 ~height:400;
   
	let box1 = GPack.hbox ~width:250 ~packing:window#add () in
	let vbox = GPack.vbox ~border_width:8 ~width:650  ~spacing:8 ~packing:box1#add () in
 
   let model = create_models !pool_ref in
	
	
	let term_box =  GPack.vbox ~border_width:8 ~height:350 ~spacing:8 ~packing:vbox#add () in 
	un(GMisc.label  
	~text:"Terms" 
	~packing:term_box#pack ()); 

	let sw_terms = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC 
		~vpolicy:`AUTOMATIC ~packing:term_box#add () in 
		
	let ter_treeview = GTree.view ~model ~packing:sw_terms#add () in 
				ter_treeview#set_rules_hint true; 
				ter_treeview#selection#set_mode `MULTIPLE; 
				add_columns ~view:ter_treeview ~model; 
	un(ter_treeview#connect#row_activated ~callback:(on_row_activated pool_ref  ter_treeview
	~dispEvaluate: (List.exists (function DisplayEvaluate -> true |_->false) settings)));
		
	
	let boxMenu = GPack.vbox ~width:200 ~packing:box1#add () in
	let panel ?(box = boxMenu) title = 
		let pan = GBin.frame ~label:(title^ "...") ~packing:box#pack ( ) in
		GPack.vbox ~width:80 ~packing:pan#add ( ) in
	
	let infoPanel = panel "Gene pool information..." in
	let searchPanel = panel "Stats..." in
	let insertPanel =  panel "Insert..." in     
	let controlPanel =  panel "Generate..." in     
    let closePanel =  panel "Commands..." in 
	
	let empty_entry ?(editable=false) ?(text="") packer ( ) = 
    GEdit.entry ~editable ~text  ~width:150  ~packing:packer#add ( ) in
	let button str packer ( ) = GButton.button ~label:str ~packing:packer#add () in
		   

 	let ins_label, ins_btn = 
	empty_entry ~editable:true insertPanel ( ), 
    button "Insert expr" insertPanel ( ) in
 

	
    
    let search_by_expr_label, search_by_expr_btn = 
	empty_entry ~editable:true searchPanel ( ), 
    button "View size distribution" searchPanel ( ) in
	let exprSearch( ) = 
		let str_out = ref "" in
		gpIter 
		(fun _ _ lst ->
			List.iter (fun alle -> str_out := (!str_out ^  (string_of_int (alleComplexity alle)) ^ "\n")) lst )
		!pool_ref;
		prf ~filename:(Some "allele_size_distribution.txt") !str_out in
	un(search_by_expr_btn#connect#clicked  ~callback:exprSearch);	
	
	
	
    let compStep, constraintFun, initComp= 
    (fold_left (fun default_val -> function
		ShowGrowByComp comp->comp
		|_->default_val) 10000 settings), 
	(fold_left (fun default_val -> function
		ConstraintFunction constrFunc -> constrFunc
		|_->default_val) (fun _ expr-> complexity_of_expr expr < 70) settings),
	(fold_left (fun default_val -> function 
		BuildInit  x -> x
		|_ -> default_val) 0 settings) - (comp !pool_ref)  in
	let update_button = button ("Update")  closePanel ( ) in  
	let show_btn = GButton.check_button  
				~label:"Compact" 
				~active:true
				~packing:closePanel#add ( ) in
	let list_btn = GButton.check_button  
				~label:"Order by type" 
				~active:true
				~packing:closePanel#add ( ) in
				

	
	let num_elt_label, tot_comp_label, 
	meanFitnessLabel, stdFitnessLabel, medFitnessLabel   = 
		empty_entry infoPanel ( ),
		empty_entry infoPanel ( ),
		empty_entry infoPanel ( ),
		empty_entry infoPanel ( ),
		empty_entry infoPanel ( ) in
    
    let updateInfo ( )= 
		let ctx = gpContext !pool_ref in
		let exprList = (fold_left (fun acc -> function
			| ShowOnlySubset exprLst -> exprLst @ acc 
			|_->acc) [ ]  settings) in
		if (List.length exprList > 0) then (
				flat_list  ~exprList ctx 
				~viewType:(if show_btn#active then Compact else Alpha) 
				~model)
		else( 
			let geneLst = get_alleles !pool_ref in 
			List.iter (fun (a,b) -> a#set_text b)
			[(num_elt_label, "There are " ^ string_of_int (card  !pool_ref) ^ " elts in the pool");
			(tot_comp_label, "Total complexity is " ^ string_of_int (comp !pool_ref)); 
			(meanFitnessLabel, "Mean Fitness of genes is " ^ string_of_float (mean geneLst alleFitness)); 
			(stdFitnessLabel, "STD Fitness of genes is " ^ string_of_float (sqrt (variance geneLst alleFitness)));
			(medFitnessLabel, "Median Fitness of genes is " ^ string_of_float (median geneLst alleFitness))];
			let viewType = if show_btn#active then Compact else Alpha in
			if list_btn#active 
				then update ~viewType !pool_ref ~model
				else flat_list ctx ~geneLst ~viewType ~model) in
	
	
	updateInfo ( );
	un(update_button#connect#clicked  ~callback:updateInfo); 
    un(show_btn#connect#toggled  ~callback:updateInfo); 
	un(list_btn#connect#toggled  ~callback:updateInfo); 

	let exprIns( ) = 
		let expr = parse_string (ins_label#text) ctx in
		(match expr with 
		|Te(te,_) -> BlockPopulation.insert_expression !pool_ref te None NoSpec
		|_->( )); 
		updateInfo ( ) in
	un(ins_btn#connect#clicked  ~callback:exprIns);			
    
    
    if exists (function ShowGrowByOne -> true |_->false) settings 
    then ( 
    let callb ( ) = 
		buildToComplexity  Block !pool_ref  ~model constraintFun ( );
		updateInfo ( ) in
    
    let grow_by_one_button = button "Grow by block"  controlPanel ( ) in
	un(grow_by_one_button#connect#clicked  ~callback:callb));
	let callb size ( ) = 
		buildToComplexity (Complexity size) !pool_ref 
		~model constraintFun ( );
		updateInfo ( ) in
		

	
	let grow_to_button = 
	button ("Add " ^ string_of_int compStep ^ " units of complexity")  controlPanel ( ) in  
	un(grow_to_button#connect#clicked  ~callback:(callb compStep)); 
	if initComp	> 0 then callb initComp ( );
	if exists (function Hide -> true |_->false) settings 
	then	( )	
	else window#show()
	
	
	
	
	
	